Here we model an intervention to address malnutrition among school-aged children in urban Hanoi. The gardens will be existing areas on school grounds. The STEM option gardens will be designed to for teaching about nutrition and STEM (an approach to learning and development that integrates science, technology, engineering and maths) at primary and secondary schools.

The model was developed across several iterative workshops in July 2023. These included decision definition, conceptual model development of the selected decision and an initial programming session with preliminary model results. The resulting model was further developed through August to November 2023. A test run of the intervention will be carried out by the Center for the Development of Organic Agriculture (CODAS) under the Association of Organic Agriculture of Vietnam. In the 2nd year the garden is expected to start running well. The 3rd year is when the STEM education plan will be fully running.

Should urban Hanoi school boards invest time and money in creating school gardens? Should they invest in formal STEM education as part of these gardens?

Urban Hanoi school garden

This is the link to our simulation of the school garden intervemntion options.

# Source our model
source("CODAS_Garden_Model.R")
## 
## Attaching package: 'decisionSupport'
## The following objects are masked _by_ '.GlobalEnv':
## 
##     chance_event, discount, vv
## Warning: Variable: outside_investment_value   distribution: posnorm
## Calculated value of 5%-quantile: 1.77932900574854
##   Target value of 5%-quantile:     1
##   Calculated cumulative probability at value 1 : 0.0289226319595083
##   Target  cumulative probability at value 1 : 0.05
##   Mean scaled difference: 0.4215474
## Warning in paramtnormci_numeric(p = p, ci = ci, lowerTrunc = lowerTrunc, : Calculated value of 5%-quantile: 1.77932900574854
##   Target value of 5%-quantile:     1
##   Calculated cumulative probability at value 1 : 0.0289226319595083
##   Target  cumulative probability at value 1 : 0.05
##   Mean scaled difference: 0.4215474
# Ensure consistent results with the random number generator
# not for each 'run' of the MC simulation but for 
# consistency each time we call on the simulation 
set.seed(1234) 

garden_simulation_results <- mcSimulation(
  estimate = estimate_read_csv("inputs_school_garden.csv"),
  model_function = school_garden_function,
  numberOfModelRuns = 1000, #run 1000 times
  functionSyntax = "plainNames"
)
## Warning: Variable: outside_investment_value   distribution: posnorm
## Calculated value of 5%-quantile: 1.77932900574854
##   Target value of 5%-quantile:     1
##   Calculated cumulative probability at value 1 : 0.0289226319595083
##   Target  cumulative probability at value 1 : 0.05
##   Mean scaled difference: 0.4215474

## Warning: Calculated value of 5%-quantile: 1.77932900574854
##   Target value of 5%-quantile:     1
##   Calculated cumulative probability at value 1 : 0.0289226319595083
##   Target  cumulative probability at value 1 : 0.05
##   Mean scaled difference: 0.4215474

Here is a plot of the Net Present Value (i.e. current value of the future benefits) of the three options. "NPV_garden" is the value of the 5 years of the garden intervention."NPV_garden_STEM" is the same garden but with the additional costs and benefits of a full STEM education program, "NPV_no_garden" is the result of 5 years of using the land for something that is not related to the garden, i.e. as a playground or for parking:

source("functions/plot_distributions.R")
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.3     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.4.4     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.0
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
plot_distributions(mcSimulation_object = garden_simulation_results, 
                                    vars = c("NPV_garden","NPV_garden_STEM", "NPV_no_garden"),
                                    method = 'hist_simple_overlay', 
                                    base_size = 7, 
                                    x_axis_name = "Comparative NPV outcomes")

Framing the outcomes

Under Prospect Theory the way we present NPV values can influence decision makers - the same information presented in different ways can lead to different decisions. For example, framing a projected NPV gain as a “reduction in potential loss” might make it more attractive to decision makers due to loss aversion.

Here we plot the distribution for the decision and frame the projected NPV gain for the ‘decision’. These are distributions for the options, with the NPV values of the no garden option subtracted from those for the garden, the decision and garden with STEM, the decision_STEM. We display this as a “Reduction in potential loss” as it is expected to be more attractive to decision makers due to loss aversion, i.e. school boards might put more emphasis on avoiding potential losses than on seeking gains. We can frame our results as a strategy that minimizes losses rather than one that maximizes gains.

plot_distributions(mcSimulation_object = garden_simulation_results, 
                                    vars = c("decision", "decision_STEM"),
                                    method = 'hist_simple_overlay', 
                                    base_size = 7,  
                                    x_axis_name = "Reduction in potential loss")

Summary of results for the decision

Summary

Here we provide a summary of the garden intervention options with gt_plt_summary() from {gtExtras} and with options from {svglite}.

# Subset the outputs from the mcSimulation function (y) to summarize only on the variables that we want.
# names(garden_simulation_results$x)
mcSimulation_summary <- data.frame(garden_simulation_results$x[2:61],
 # names(garden_simulation_results$x)
                                 garden_simulation_results$y[1:7])

gt_plt_summary(mcSimulation_summary)
mcSimulation_summary
1000 rows x 67 cols
Column Plot Overview Missing Mean Median SD
discount_rate 3.49.4 0.0% 6.5 6.5 0.9
size_of_garden 28123 0.0% 75.2 75.2 14.9
CV_value 0.010.53 0.0% 0.3 0.3 0.1
inflation_rate 2.912.2 0.0% 7.5 7.5 1.5
if_students_like 0.390.90 0.0% 0.6 0.6 0.1
if_parents_like 0.351.00 0.0% 0.7 0.7 0.1
if_community_likes 0.010.98 0.0% 0.5 0.5 0.2
if_effective_manage 0.410.82 0.0% 0.6 0.6 0.1
if_garden_yield_enough 0.160.76 0.0% 0.5 0.5 0.1
if_garden_healthy 0.290.99 0.0% 0.7 0.7 0.1
if_teachers_like 0.031.00 0.0% 0.5 0.5 0.2
if_effective_teaching 0.021.00 0.0% 0.6 0.6 0.2
if_effective_training 0.020.99 0.0% 0.5 0.5 0.2
if_offer_green_space 0.320.99 0.0% 0.7 0.7 0.1
if_reduce_polution 0.080.64 0.0% 0.3 0.3 0.1
if_biophysical_good 0.030.65 0.0% 0.3 0.3 0.1
equipment_cost 31120 0.0% 74.4 74.8 15.6
construction_cost 439 0.0% 22.6 22.6 4.8
garden_designing_costs 7.817.0 0.0% 12.5 12.5 1.6
teacher_training_cost 126 0.0% 12.5 12.7 4.5
school_board_planning 314 0.0% 9.0 9.0 1.8
teaching_equipment 313 0.0% 7.6 7.5 1.5
compost_starting 313 0.0% 7.5 7.5 1.5
worm_starting 0.96.4 0.0% 3.4 3.4 0.9
livestock_costs 0.66.5 0.0% 3.5 3.5 0.9
if_family_pays_establishment 0.100.61 0.0% 0.3 0.4 0.1
establishment_family_portion_paid 0.080.66 0.0% 0.3 0.3 0.1
maintaining_labor 1749 0.0% 32.6 32.4 4.6
teacher_salary_cost 1534 0.0% 24.9 25.0 3.1
teaching_equipment_annual 313 0.0% 7.6 7.6 1.5
teaching_tools 0.66.0 0.0% 3.5 3.5 0.9
seed_costs 0.72.6 0.0% 1.5 1.5 0.3
fertilizer 0.52.5 0.0% 1.5 1.5 0.3
plant_protection 0.76.2 0.0% 3.5 3.6 0.9
livestock_maint 013 0.0% 6.0 6.1 2.4
annual_teacher_training 2.36.1 0.0% 4.0 4.0 0.6
if_school_has_canteen 0.080.61 0.0% 0.3 0.3 0.1
canteen_savings 213 0.0% 7.5 7.5 1.6
sale_of_yield 139 0.0% 20.1 20.1 6.0
extra_cirricular_savings 0150 0.0% 60.9 61.6 24.4
formal_edu_savings 032 0.0% 9.2 8.8 5.8
formal_edu_savings_STEM 0144 0.0% 60.4 60.1 24.6
outside_investment_value 0258 0.0% 33.0 23.4 32.5
outside_investment_value_STEM 0888 0.0% 170.0 125.1 155.6
increased_enrollment_value 028 0.0% 9.3 8.3 6.0
increased_enrollment_value_STEM 0143 0.0% 50.8 49.6 27.2
if_increase_tuition 0.0000.041 0.0% 0.0 0.0 0.0
if_increase_tuition_STEM 0.010.40 0.0% 0.2 0.2 0.1
tuition_increase 213 0.0% 7.5 7.5 1.6
child_veg_access 3.312.2 0.0% 7.5 7.5 1.5
child_healthier_choices 1172 0.0% 58.3 57.2 23.8
child_healthier_choices_STEM 2704 0.0% 298.1 291.7 125.4
green_space_value 51252 0.0% 149.5 151.0 29.4
reduce_polution_value 524 0.0% 15.0 14.9 3.1
school_event_value 073 0.0% 29.6 29.5 12.0
school_event_freq 014 0.0% 6.1 6.0 2.5
value_of_non_garden_land_use 863 0.0% 35.5 35.4 9.3
if_parking 0.010.22 0.0% 0.1 0.1 0.0
parking_value 56256 0.0% 149.2 147.2 30.2
costs_of_non_garden_land_use 0.37.3 0.0% 3.0 2.9 1.2
NPV_garden -663K 0.0% 621.5 550.3 355.1
NPV_garden_STEM 104K 0.0% 1,399.2 1,302.6 645.7
NPV_no_garden 692K 0.0% 327.5 247.4 277.6
decision -1.5K2.4K 0.0% 294.0 290.6 455.4
decision_STEM -1.1K4.2K 0.0% 1,071.7 985.4 707.5
total_costs 267562 0.0% 412.8 412.4 36.3
total_costs_STEM 503816 0.0% 642.7 644.1 43.4

Summary of the savings for the passive education garden option

summary(garden_simulation_results$y$decision)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1499.07    56.25   290.57   294.05   542.85  2376.05

Summary of the savings for the formal STEM education garden option

summary(garden_simulation_results$y$decision_STEM)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1131.7   600.4   985.4  1071.7  1459.6  4192.8

Summary of costs

summary(garden_simulation_results$y$total_costs)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   266.6   389.5   412.4   412.8   437.0   562.3
summary(garden_simulation_results$y$total_costs_STEM)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   503.1   611.8   644.1   642.7   670.6   816.3

First year

summary(garden_simulation_results$y$Cashflow_garden1)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -135.330  -36.560    3.442   13.786   55.717  382.954
summary(garden_simulation_results$y$Cashflow_garden_STEM1)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -168.02   35.18  110.95  126.73  194.57  699.93

Cashflow of the garden option without formal STEM education

source("functions/plot_cashflow.R")
plot_cashflow(mcSimulation_object = garden_simulation_results, 
              cashflow_var_name = "Cashflow_garden")
## Warning in FUN(X[[i]], ...): NAs introduced by coercion

## Warning in FUN(X[[i]], ...): NAs introduced by coercion

## Warning in FUN(X[[i]], ...): NAs introduced by coercion

## Warning in FUN(X[[i]], ...): NAs introduced by coercion
## Warning: Removed 5 rows containing missing values (`geom_line()`).
## Removed 5 rows containing missing values (`geom_line()`).

Cashflow of the garden option with formal STEM education

source("functions/plot_cashflow.R")
plot_cashflow(mcSimulation_object = garden_simulation_results, 
              cashflow_var_name = "Cashflow_garden_STEM")

Expected Value of Perfect Information (EVPI)

Here we assess value of information with the multi_EVPI function.

# Subset the outputs from the mcSimulation function (y) by selecting the correct variables be sure to run the multi_EVPI only on the variables that we want. Find them with names(garden_simulation_results$y)
mcSimulation_table <- data.frame(garden_simulation_results$x, 
                                 garden_simulation_results$y[1:5])

Value of information for the garden option (no STEM).

source("functions/multi_EVPI.R")
# first_out_var is the first result variable in the table, "NPV_garden" in our case.
evpi <- multi_EVPI(mc = mcSimulation_table, first_out_var = "NPV_garden")
## [1] "Processing 5 output variables. This can take some time."
## [1] "Output variable 1 (NPV_garden) completed."
## [1] "Output variable 2 (NPV_garden_STEM) completed."
## [1] "Output variable 3 (NPV_no_garden) completed."
## [1] "Output variable 4 (decision) completed."
## [1] "Output variable 5 (decision_STEM) completed."
source("functions/plot_evpi.R")
plot_evpi(evpi, decision_vars = "decision")

Value of information for the garden option with formal STEM education.

# using the results of the same multi_EVPI
plot_evpi(evpi, decision_vars = "decision_STEM")
## Warning: There are no variables with a positive EVPI. You probably do not need
## a plot for that.

PLS

We use Projection to Latent Structures model to get some sense of the correlation strength and direction for model variables and our outcome variables.

For passive education garden option

source("functions/pls_model.R")
pls_result <- pls_model(object = garden_simulation_results,
                                resultName = names(garden_simulation_results$y)[1], # the "NPV_garden" 
                                ncomp = 1)
# read in the common input table
input_table <- read.csv("inputs_school_garden.csv")
# source the plot function
source("functions/plot_pls.R")
plot_pls(pls_result, input_table = input_table, threshold = 0.9)

For school garden with formal STEM education

pls_result_STEM <- pls_model(object = garden_simulation_results,
                                resultName = names(garden_simulation_results$y)[2], # the "NPV_garden_STEM" 
                                ncomp = 1)

plot_pls(pls_result_STEM, input_table = input_table, threshold = 0.9)

The full repository can be accessed at https://github.com/CWWhitney/nifam_codas_school_garden with the following QR code.